home *** CD-ROM | disk | FTP | other *** search
/ Aminet 16 / Aminet 16 (1996)(GTI - Schatztruhe)[!][Dec 1996].iso / Aminet / util / conv / dbf2asc2.lha / DBF2ASC / English / dbview2_UK.bas < prev    next >
BASIC Source File  |  1996-07-29  |  9KB  |  363 lines
  1. REM $STACK
  2. REM $NOEVENT
  3. REM $NOBREAK
  4. REM $NOAUTODIM
  5. REM $NOLINES
  6. REM $NODEBUG
  7. REM $OVERFLOW
  8. REM $ADDICON
  9. REM $ERRORS
  10. REM $INCPATH MB_INCLUDES:BH
  11. REM $LIBPATH MB_INCLUDES:BMAP
  12. REM $NOWINDOW
  13. REM $NOLIBRARY
  14. REM MAXONBASIC3
  15.  
  16. revision$="$VER: MicroBase dBView 1.0.3, Rev. 29.07.1996 - ©FR-SW"
  17. WINDOW 5,MID$(revision$,7,22)
  18. DEFINT a - z
  19. CONST TAG_DONE&=0
  20. CONST DBFBUFLEN&=4097
  21. DIM frtags&(20)
  22. DIM q&(4097)
  23. ext$=".DBF"
  24. reverse$=""
  25. accept$=""
  26.  
  27. DECLARE FUNCTION trim$(a$)
  28. DECLARE SUB forminput(fil%,a$)
  29.  
  30. LIBRARY "exec.library"
  31. DECLARE FUNCTION AllocMem&(l&,r&) LIBRARY
  32. DECLARE FUNCTION FreeMem&(b&,l&) LIBRARY
  33. LIBRARY "dos.library"
  34. DECLARE FUNCTION xOpen&(n&,m&) LIBRARY
  35. DECLARE FUNCTION xClose&(fh&) LIBRARY
  36. DECLARE FUNCTION xRead&(fh&,buf&,l&) LIBRARY
  37. DECLARE FUNCTION Seek&(fh&,p&,m&) LIBRARY
  38. REM $include asl.bh
  39. LIBRARY OPEN "exec.library"
  40. LIBRARY OPEN "dos.library"
  41. LIBRARY OPEN "asl.library"
  42.  
  43. dbfansi$=""
  44. RESTORE ibm
  45. FOR i%=0 TO 255
  46.   READ t%
  47.   dbfansi$=dbfansi$+CHR$(t%)
  48. NEXT i%
  49.  
  50. GOSUB aslreq
  51.  
  52. IF back$>""
  53.   fhbuf&=AllocMem&(DBFBUFLEN&,65539&)
  54.   bac$=back$+CHR$(0)
  55.   back&=SADD(bac$)
  56.   fhdos&=xOpen&(back&,1004)
  57.   r&=xRead&(fhdos&,fhbuf&,1)
  58.   dbfvers$=CHR$(PEEK(fhbuf&))
  59.   dbf&=ASC(dbfvers$)
  60.   update$=""
  61.   r&=xRead(fhdos&,fhbuf&,1)
  62.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  63.   r&=xRead(fhdos&,fhbuf&,1)
  64.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  65.   r&=xRead(fhdos&,fhbuf&,1)
  66.   update$=update$+RIGHT$("00"+STR$(PEEK(fhbuf&)),2)
  67.   update$=RIGHT$(update$,2)+"."+MID$(update$,3,2)+"."+LEFT$(update$,2)
  68.   r&=xRead&(fhdos&,fhbuf&,4)
  69.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  70.   GOSUB umdrehen
  71.   reccount&=CVL(reverse$) 
  72.   r&=xRead&(fhdos&,fhbuf&,2)
  73.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  74.   GOSUB umdrehen
  75.   headerlength&=CVI(reverse$)
  76.   r&=xRead&(fhdos&,fhbuf&,2)
  77.   reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))
  78.   GOSUB umdrehen
  79.   reclength&=CVI(reverse$)
  80.   fieldcount&=(headerlength&-1)/32-1
  81.   DIM fldnam$(fieldcount&),fldtyp$(fieldcount&),fldadr&(fieldcount&)
  82.   DIM fldlen&(fieldcount&),flddec&(fieldcount&)
  83.   dbf$="<unknown>"
  84.   dbt$=dbf$
  85.   db3p$="Ashton Tate dBASE III+"
  86.   fp25$="Microsoft FoxPro 2.5"
  87.   la3$="Lotus Approach 3.0 [dBASE IV]"
  88.   IF dbf&=3
  89.     dbf$=db3p$
  90.     dbt$=""
  91.   END IF
  92.   IF dbf&=131
  93.     dbf$=db3p$
  94.     dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  95.   END IF
  96.   IF dbf&=139
  97.     dbf$=la3$
  98.     dbt$=LEFT$(back$,LEN(back$)-3)+"DBT"
  99.   END IF
  100.   IF dbf&=245
  101.     dbf$=fp25$
  102.     dbt$=LEFT$(back$,LEN(back$)-3)+"FPT"
  103.   END IF
  104.   PRINT "1. File"
  105.   PRINT "--------"
  106.   PRINT
  107.   PRINT "File name:     ";back$
  108.   PRINT "Version :      ";dbf$
  109.   PRINT "Memos:         ";dbt$
  110.   PRINT "Date:          ";update$
  111.   PRINT "Fields:        "fieldcount&
  112.   PRINT "Records:       ";reccount&
  113.   PRINT "Header length: ";headerlength&
  114.   PRINT
  115.   a$=INPUT$(1)
  116.   feld&=0
  117.   FOR i&=1 TO fieldcount&
  118.     CLS
  119.     PRINT "2. Fields"
  120.     PRINT "---------"    
  121.     PRINT
  122.     r&=Seek&(fhdos&,(32*i&),(-1&))
  123.     r&=xRead&(fhdos&,fhbuf&,11&)
  124.     POKE fhbuf&+11,0
  125.     PRINT "Field: ";i&
  126.     fldnam$=PEEK$(fhbuf&)
  127.     fldnam$(i&)=trim$(fldnam$)
  128.     PRINT "Name: ";fldnam$(i&)
  129.     r&=xRead&(fhdos&,fhbuf&,1&)
  130.     fldtyp$(i&)=CHR$(PEEK(fhbuf&))
  131.     PRINT "Type: ";fldtyp$(i&)
  132.     r&=xRead&(fhdos&,fhbuf&,4&)
  133.     reverse$=CHR$(PEEK(fhbuf&))+CHR$(PEEK(fhbuf&+1))+CHR$(PEEK(fhbuf&+2))+CHR$(PEEK(fhbuf&+3))
  134.     GOSUB umdrehen
  135.     fldadr&(i&)=CVL(reverse$)
  136.     PRINT "Addres: ";fldadr&(i&)
  137.     r&=xRead&(fhdos&,fhbuf&,1&)
  138.     fldlen&(i&)=PEEK(fhbuf&)
  139.     PRINT "Length: ";fldlen&(i&);",";
  140.     r&=xRead&(fhdos&,fhbuf&,1&)
  141.     flddec&(i&)=PEEK(fhbuf&)
  142.     PRINT fld_dec&(i&)
  143.     IF fldtyp$(i&)="M"
  144.       q&(i&)=0
  145.     ELSE
  146.       INCR feld&
  147.       q&(i&)=fldlen&(i&)
  148.     END IF
  149.     IF fldtyp$(i&)="D"
  150.       q&(i&)=q&(i&)+2
  151.     END IF
  152.     a$=INPUT$(1)
  153.   NEXT i&
  154.     CLS
  155.     PRINT "3. View records"
  156.     PRINT "---------------"
  157.     PRINT
  158.     ic$="Y"
  159.   PRINT "Convert ASCII chars to ANSI (Y|N) ";
  160.   forminput 1,ic$
  161.   IF UCASE$(ic$)="Y"
  162.     ic!=1
  163.   END IF
  164.   PRINT
  165.   PRINT
  166.   i&=1
  167.   WHILE UCASE$(weiter$)<>"Q"
  168.     p&=Seek&(fhdos&,headerlength&+reclength&*(i&-1),-1&)
  169.     r&=xRead&(fhdos&,fhbuf&,1&)
  170.     recdel$=CHR$(PEEK(fhbuf&))
  171.     out$=""
  172.     CLS
  173.     PRINT "3. View records"
  174.     PRINT "---------------"
  175.     PRINT
  176.     PRINT "Record: ";i&;
  177.     LOCATE CSRLIN,50
  178.     IF recdel$="*"
  179.       PRINT "*DELETED*"
  180.     END IF
  181.     PRINT
  182.     FOR t&=1 TO fieldcount&
  183.       PRINT fldnam$(t&);":";
  184.       LOCATE CSRLIN,15
  185.       r&=xRead&(fhdos&,fhbuf&,fldlen&(t&))
  186.       POKE fhbuf&+fldlen&(t&),0
  187.       a$=PEEK$(fhbuf&)
  188.       d$ = ""
  189.       ft$= fldtyp$(t&)
  190.       IF ft$ = "C"
  191.         IF ic!
  192.           ibm2ansi (a$)
  193.           d$=ibm2ansi$
  194.         ELSE
  195.           d$=a$
  196.         END IF
  197.       END IF
  198.       IF ft$ = "N"
  199.         IF flddec&(t&)=0
  200.           d$=a$
  201.         ELSE
  202.           d$=LEFT$(a$,fldlen&(t&)-flddec&(t&)-1)+"."+MID$(a$,fldlen&(t&)-flddec&(t&)+1)
  203.           IF LEFT$(d$,1)="."
  204.             d$=MID$(d$,2)
  205.           END IF
  206.         END IF
  207.         uix&=INSTR(d$,",")
  208.         IF uix&<>0
  209.           MID$(d$,uix&,1)="."
  210.         END IF
  211.       END IF
  212.       IF ft$ = "D"
  213.         d$=RIGHT$(a$,2)+"."+MID$(a$,5,2)+"."+LEFT$(a$,4)
  214.       END IF
  215.       IF ft$ = "M"
  216.         d$="<MEMO fields not supported>"
  217.       END IF
  218.       IF ft$="L"
  219.         d$=a$
  220.       END IF
  221.       PRINT d$
  222.       IF INKEY$<>""
  223.         x$=INPUT$(1)
  224.       END IF
  225.     NEXT t&
  226.     weiter$=INPUT$(1)
  227.     IF weiter$="+"
  228.       INCR i&
  229.     END IF
  230.     IF weiter$="*"
  231.       i& = i& + 10
  232.     END IF
  233.     IF weiter$="-"
  234.       DECR i&
  235.     END IF
  236.     IF weiter$="_"
  237.       i& = i& - 10
  238.     END IF  
  239.     IF (i& > reccount&)
  240.       i&=1
  241.     END IF
  242.     IF (i& < 1)
  243.       i&=reccount&
  244.     END IF
  245.   WEND
  246.   r&=xClose&(fhdos&)
  247.   r&=FreeMem&(fhbuf&,DBFBUFLEN&)
  248. END IF
  249. END
  250.  
  251. umdrehen:
  252.     tvi$=reverse$
  253.     reverse$=""
  254.     FOR tt&=LEN(tvi$) TO 1 STEP -1
  255.       reverse$=reverse$+MID$(tvi$,tt&,1)
  256.     NEXT tt&
  257. RETURN
  258.  
  259. SUB ibm2ansi(tvi$)
  260.     SHARED ibm2ansi$, dbfansi$
  261.     ibm2ansi$=""
  262.     FOR tt&=1 TO LEN(tvi$)
  263.         ft%=ASC(MID$(tvi$,tt&,1))
  264.         tvw$=MID$(dbfansi$,ft%+1,1)
  265.         IF tvw$<>CHR$(1)
  266.           ibm2ansi$=ibm2ansi$+tvw$
  267.         END IF
  268.     NEXT tt&
  269. END SUB
  270.  
  271. aslreq:
  272.     back$=""
  273.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&,"Select a dBASE file", _
  274.             ASLFR_InitialFile&,"", _
  275.             ASLFR_InitialDrawer&, CURDIR$, _
  276.             TAG_DONE&
  277.  
  278.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  279.     IF fr& THEN
  280.         IF AslRequest&(fr&,0) THEN
  281.             aslfile$=PEEK$(PEEKL(fr&+fr_File))
  282.             asldir$=PEEK$(PEEKL(fr&+fr_Drawer))
  283.             IF RIGHT$(asldir$,1)<>":" AND RIGHT$(asldir$,1)<>"/"
  284.               asldir$=asldir$+"/"
  285.             END IF
  286.             back$=asldir$+aslfile$
  287.         END IF
  288.         FreeASlRequest fr&
  289.     END IF
  290. RETURN    
  291.  
  292. FUNCTION trim$(a$)
  293.   trim$=LTRIM$(RTRIM$(a$))
  294. END FUNCTION
  295.  
  296. SUB forminput(fil%,a$)
  297. 'fil%=maximum length a$=input/output
  298. 'Quit with <Return>, delete input field with <ESC>.
  299.   fiz%=CSRLIN
  300.   fis%=POS(0)
  301.   fis$=SPACE$(fil%)
  302.   fip%=1
  303.   fi$=""
  304.   a$=LEFT$(LTRIM$(RTRIM$(a$)),fil%)
  305.   WHILE fi$<>CHR$(13)
  306.     LOCATE fiz%,fis%
  307.     PRINT LEFT$(a$+fis$,fil%);
  308.     LOCATE fiz%,fis%+fip%-1
  309.     COLOR 0,1
  310.     PRINT LEFT$(MID$(a$,fip%,1)+" ",1);
  311.     COLOR 1,0
  312.     fi:
  313.     fi$=INKEY$
  314.     IF fi$="" GOTO fi
  315.     fia%=ASC(fi$)
  316.     SELECT CASE fia%
  317.     CASE 13
  318.     CASE 30
  319.       INCR fip%
  320.     CASE 31
  321.       DECR fip%
  322.     CASE 8
  323.       IF fip%>1
  324.         a$=LEFT$(a$,fip%-2)+MID$(a$,fip%)
  325.         DECR fip%
  326.       END IF
  327.     CASE 27
  328.       a$=""
  329.       fip%=1
  330.     CASE ELSE
  331.       IF ((ASC(fi$) AND 127) > 31)
  332.         a$=LEFT$(a$+fis$,fip%-1)+fi$+MID$(a$,fip%)
  333.       END IF
  334.     END SELECT
  335.     IF fip%<1
  336.       fip%=1
  337.     END IF
  338.     IF fip%>fil%
  339.       fip%=fil%
  340.     END IF
  341.   WEND
  342.   a$=LEFT$(a$,fil%)
  343.   LOCATE fiz%,fis%
  344.   PRINT LEFT$(a$+fis$,fil%);
  345. END SUB
  346.  
  347. ibm:
  348. DATA 1, 1, 1, 1, 1, 1, 1, 183, 176, 1, 1, 1, 1, 1, 1, 45, 1, 1
  349. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 32, 33, 34, 35, 36
  350. DATA 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55
  351. DATA 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74
  352. DATA 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93
  353. DATA 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109
  354. DATA 110, 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124
  355. DATA 125, 126, 1, 199, 252, 233, 226, 228, 224, 229, 231, 234, 235, 232, 239
  356. DATA 238, 236, 196, 197, 201, 230, 198, 244, 246, 242, 251, 249, 255, 214, 220
  357. DATA 162, 163, 165, 1, 1, 225, 237, 243, 250, 241, 209, 170, 186, 191, 1, 172
  358. DATA 189, 188, 161, 171, 187, 1, 1, 1, 124, 1, 1, 1, 1, 1, 1, 1, 1
  359. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  360. DATA 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
  361. DATA 223, 1, 182, 1, 1, 181, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 177, 1
  362. DATA 1, 1, 1, 1, 1, 176, 183, 183, 1, 1, 178, 183, 32
  363.